home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / CGI shell / webTTT.4th < prev    next >
Text File  |  1995-09-18  |  3KB  |  112 lines
  1. \
  2. \  Web TIC TAC TOE in Forth.  Mindless, for demonstration purposes only.
  3. \
  4. \  Ronald T. Kneusel, 18-Sep-95
  5. \  rkneusel@post.its.mcw.edu
  6. \
  7. \  This code requires the CGIshell.4th file.
  8. \
  9.  
  10. ( load the CGI shell code )
  11.  
  12. ( --> CGIshell.4th )
  13.  
  14. ( *********************** Strings and such ************************* )
  15.  
  16. 2048 String>> output   \ put the reply here
  17.    5 String>> choice    \ user's move here
  18.  
  19. message[ s0 <h2>Web Tic Tac Toe - A CGI demo in Forth</h2><hr size=2>]
  20. message[ s1 <b>Your move....</b><p>]
  21. message[ s2 <b>Game over, thanks for playing</b><p>]
  22. message[ s3 <b>Illegal move, try again...</b><p>]
  23. message[ bd <tt>1 | 2 | 3</tt><br><tt>4 | 5 | 6</tt><br><tt>7 | 8 | 9</tt>]
  24. message[ c1 <select name="c"><option>1<option>2<option>3<option>4<option>5]
  25. message[ c2 <option>6<option>7<option>8<option>9</select>]
  26. message[ f1 <form method=post action="ttt.cgi">]
  27. message[ f2 </form>]
  28. message[ go <input type=submit value="GO">]
  29. message[ fn c]  \ Field name
  30.  
  31. \ offsets into the board string
  32. create offset  4 , 8 , 12 , 26 , 30 , 34 , 48 , 52 , 56 ,
  33.  
  34. ( *********************** Play TIC TAC TOE ************************* )
  35.  
  36. : <> = 0= ; macro
  37.  
  38. variable n
  39. : random ( n -- n' ) ( puts a random number from 1 to n on stack )
  40.    n ! 0 >r ,$ A861 r> abs n @ 32767 */ 1+ ;
  41.  
  42. : set ( v n -- )  \ set value for position n
  43.    1- 2* offset + @ bd + c! ;
  44.  
  45. : get ( n -- val )  \ return value of position n
  46.    1- 2* offset + @ bd + c@ ;
  47.  
  48. : over? ( -- t|f )  \ true if the game is over (all spaces filled)
  49.    -1 
  50.    10 1 DO
  51.      r get 88 <>
  52.      r get 79 <> and IF  drop 0 THEN
  53.    LOOP ;
  54.  
  55. variable ILLEGAL  0 ILLEGAL ! \ true if illegal move
  56. variable GOODBYE  0 GOODBYE ! \ true if game over
  57. : make_a_move  \ chose a random position
  58.    88 choice c@ 48 - dup
  59.    get dup 88 = swap 79 = or IF
  60.      drop  -1 ILLEGAL !  \ bogus move
  61.    ELSE
  62.      set \ mark user's choice
  63.      over? 0= IF
  64.        9 random   \ get a position
  65.        BEGIN dup dup get 88 = 
  66.        swap get 79 = or WHILE drop 9 random  REPEAT \ chose until open
  67.        79 swap set \ set to 'O'
  68.        over? IF -1 GOODBYE ! THEN
  69.      ELSE
  70.        -1 GOODBYE !
  71.      THEN
  72.    THEN
  73. ;
  74.  
  75.  
  76. ( ********************* Apple Event Handler ************************ )
  77.  
  78. ,s sdoc  ,s WWWΩ  ae:
  79.  
  80.     output newstr          \ clear the output
  81.     
  82.     output startstring     \ new HTML string
  83.     
  84.     s0 output strcpy       \ header
  85.     
  86.     choice fn NEW @Field   \ get user's move
  87.     make_a_move            \ then computer's turn
  88.     
  89.     GOODBYE @ IF
  90.       s2 output strcpy     \ game over
  91.       bd output strcpy
  92.     ELSE
  93.       ILLEGAL @ IF
  94.         s3 output strcpy   \ illegal move
  95.       ELSE
  96.         s1 output strcpy   \ valid moves
  97.       THEN
  98.       bd output strcpy
  99.       f1 output strcpy
  100.       c1 output strcpy
  101.       c2 output strcpy
  102.       go output strcpy
  103.       f2 output strcpy
  104.     THEN
  105.     
  106.     output endstring
  107.     
  108.     output REPLY  \ send the reply
  109.     
  110.     GOODBYE @ IF  bye  THEN  \ quit if game over
  111. ;ae
  112.